Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue70/alfresco/AAStrms.pas

Pascal/Delphi Source File | 2001-05-08 | 19.9 KB | 684 lines

{*********************************************************}
{* AAStrms                                               *}
{* Copyright (c) Julian M Bucknall 2001                  *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco: Streams and filters              *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AAStrms;

interface

uses
  SysUtils,
  Classes,
  AAStrBld,
  AARegex;

type
  TaaFileStream = class(TFileStream)
    {a file stream that remembers its name}
    private
      FName : string;
    protected
    public
      constructor Create(const aFileName : string; aMode : word);
      property Name : string read FName;
  end;

  TaaReadFilter = class(TStream)
    {a read-only filter}
    private
      FSize       : longint;
      FStream     : TStream;
      FGotSizeReq : boolean;
    protected
    public
      constructor Create(aStream : TStream; aSize : longint);

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
  end;

  TaaWriteFilter = class(TStream)
    {a write-only filter}
    private
      FSize       : longint;
      FStream     : TStream;
      FGotSizeReq : boolean;
    protected
    public
      constructor Create(aStream : TStream);

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
  end;

  TaaReadBufferFilter = class(TaaReadFilter)
    {a read-only buffered filter}
    private
      FBuffer : PChar;
      FBufEnd : longint;
      FBufPos : longint;
    protected
      function rbfReadBuffer : boolean;
    public
      constructor Create(aStream : TStream; aSize : longint);
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
  end;

  TaaWriteBufferFilter = class(TaaWriteFilter)
    {a write-only buffered filter}
    private
      FBuffer : PChar;
      FCurPos : PChar;
    protected
      function wbfWriteBuffer : boolean;
    public
      constructor Create(aStream : TStream);
      destructor Destroy; override;

      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
  end;

  TaaReadTextFilter = class(TaaReadBufferFilter)
    {a read-only text filter}
    private
      FStrBuilder : TaaStringBuilder;
    protected
    public
      constructor Create(aStream : TStream; aSize : longint);
      destructor Destroy; override;

      function ReadLine : string; virtual;
      function AtEndOFStream : boolean;
  end;

  TaaLineDelimiter = ( {possible line delimiters}
     ldLF,             {..line feed}
     ldCRLF);          {..carriage return line feed}

  TaaWriteTextFilter = class(TaaWriteFilter)
    {a write-only text filter}
    private
      FLineDelim : TaaLineDelimiter;
    protected
    public
      constructor Create(aStream : TStream);

      procedure WriteLine(const S : string);

      property LineDelimiter : TaaLineDelimiter
                  read FLineDelim write FLineDelim;
  end;

  TaaDebugFilter = class(TStream)
    {a debug filter}
    private
      FLog    : TaaWriteTextFilter;
      FFile   : TFileStream;
      FStream : TStream;
    protected
      function dfGetOriginStr(aOrigin : word) : string;
    public
      constructor Create(aStream : TStream; const aLogName : string);
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
  end;

  TaaRegexTextFilter = class(TaaReadTextFilter)
    {a read-only regex text filter}
    private
      FRegexEngine : TaaRegexCompiler;
    protected
    public
      constructor Create(aStream : TStream; aSize : longint;
                   const aRegex : string);
      destructor Destroy; override;

      function ReadLine : string; override;
  end;

  TaaWindowFilter = class(TStream)
    {a window filter}
    private
      FStream  : TStream;
      FZeroPos : longint;
    protected
    public
      constructor Create(aStream : TStream; aZeroPos : longint);
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : word) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
  end;

implementation

const
  BufferSize = 8 * 1024;

{===TaaFileStream====================================================}
constructor TaaFileStream.Create(const aFileName : string;
                                       aMode : word);
begin
  FName := aFileName;
  inherited Create(aFileName, aMode);
end;
{====================================================================}


{===TaaReadFilter====================================================}
constructor TaaReadFilter.Create(aStream : TStream; aSize   : longint);
begin
  Assert(aStream <> nil,
         'TaaReadFilter.Create: the stream cannot be nil');
  inherited Create;
  FStream := aStream;
  if (aSize = -1) then
    FSize := FStream.Size
  else
    FSize := aSize;
end;
{--------}
function TaaReadFilter.Read(var Buffer; Count : longint) : longint;
begin
  Assert(not FGotSizeReq,
         'TaaReadFilter.Read: cannot read whilst getting size');
  Result := FStream.Read(Buffer, Count);
end;
{--------}
function TaaReadFilter.Seek(Offset : longint; Origin : word) : longint;
begin
  case Origin of
    soFromBeginning :
      if FGotSizeReq then begin
        Result := FStream.Position;
        if (Offset = Result) then
          Exit;
        FGotSizeReq := false;
      end;
    soFromCurrent :
      if (Offset = 0) and (not FGotSizeReq) then begin
        Result := FStream.Position;
        Exit;
      end;
    soFromEnd :
      if (Offset = 0) and (not FGotSizeReq) then begin
        Result := FSize;
        FGotSizeReq := true;
        Exit;
      end;
  else
    Assert(false,
       Format('TaaReadFilter.Seek: invalid origin (%d)', [Origin]));
  end;
  Assert(false,
         'TaaReadFilter.Seek: a read-only filter cannot seek');
  Result := 0;
end;
{--------}
function TaaReadFilter.Write(const Buffer; Count : longint) : longint;
begin
  Assert(false,
         'TaaReadFilter.Write: a read-only filter cannot write');
  Result := 0;
end;
{====================================================================}


{===TaaWriteFilter===================================================}
constructor TaaWriteFilter.Create(aStream : TStream);
begin
  Assert(aStream <> nil,
         'TaaWriteFilter.Create: the stream cannot be nil');
  inherited Create;
  FStream := aStream;
end;
{--------}
function TaaWriteFilter.Read(var Buffer; Count : longint) : longint;
begin
  Assert(false,
         'TaaWriteFilter.Read: a write-only filter cannot read');
  Result := 0;
end;
{--------}
function TaaWriteFilter.Seek(Offset : longint; Origin : word) : longint;
begin
  case Origin of
    soFromBeginning :
      if FGotSizeReq then begin
        Result := FSize;
        if (Offset = Result) then
          Exit;
        FGotSizeReq := false;
      end;
    soFromCurrent :
      if (Offset = 0) and (not FGotSizeReq) then begin
        Result := FSize;
        Exit;
      end;
    soFromEnd :
      if (Offset = 0) and (not FGotSizeReq) then begin
        Result := FSize;
        FGotSizeReq := true;
        Exit;
      end;
  else
    Assert(false,
       Format('TaaWriteFilter.Seek: invalid origin (%d)', [Origin]));
  end;
  Assert(false,
         'TaaWriteFilter.Seek: a read-only filter cannot seek');
  Result := 0;
end;
{--------}
function TaaWriteFilter.Write(const Buffer; Count : longint) : longint;
begin
  Assert(not FGotSizeReq,
         'TaaWriteFilter.Write: cannot write whilst getting size');
  Result := FStream.Write(Buffer, Count);
  inc(FSize, Result);
end;
{====================================================================}


{===TaaReadBufferFilter==============================================}
constructor TaaReadBufferFilter.Create(aStream : TStream; aSize : longint);
begin
  inherited Create(aStream, aSize);
  GetMem(FBuffer, BufferSize);
end;
{--------}
destructor TaaReadBufferFilter.Destroy;
begin
  if (FBuffer <> nil) then
    FreeMem(FBuffer, BufferSize);
  inherited Destroy;
end;
{--------}
function TaaReadBufferFilter.rbfReadBuffer : boolean;
begin
  {read the next bufferful from the stream}
  FBufEnd := FStream.Read(FBuffer^, BufferSize);
  FBufPos := 0;
  {return true if at least one byte were read, false otherwise}
  Result := FBufEnd <> FBufPos;
end;
{--------}
function TaaReadBufferFilter.Read(var Buffer; Count : longint) : longint;
var
  UserBuf     : PChar;
  BytesToGo   : longint;
  BytesToRead : longint;
begin
  {reference the buffer as a PChar}
  UserBuf := @Buffer;
  {start the counter for the number of bytes read}
  Result := 0;
  {if needed, fill the internal buffer from the underlying stream}
  if (FBufPos = FBufEnd) then
    if not rbfReadBuffer then
      Exit;
  {calculate the number of bytes to copy from the internal buffer}
  BytesToGo := Count;
  BytesToRead := FBufEnd - FBufPos;
  if (BytesToRead > BytesToGo) then
    BytesToRead := BytesToGo;
  {copy the bytes from the internal buffer to the user buffer}
  Move(FBuffer[FBufPos], UserBuf^, BytesToRead);
  {adjust the counters}
  inc(FBufPos, BytesToRead);
  dec(BytesToGo, BytesToRead);
  inc(Result, BytesToRead);
  {while there are more bytes to copy, do so}
  while (BytesToGo <> 0) do begin
    {advance the user buffer}
    inc(UserBuf, BytesToRead);
    {fill the internal buffer from the underlying stream}
    if not rbfReadBuffer then
      Exit;
    {calculate the number of bytes to copy from the internal buffer}
    BytesToRead := FBufEnd - FBufPos;
    if (BytesToRead > BytesToGo) then
      BytesToRead := BytesToGo;
    {copy the bytes from the internal buffer to the user buffer}
    Move(FBuffer^, UserBuf^, BytesToRead);
    {adjust the counters}
    inc(FBufPos, BytesToRead);
    dec(BytesToGo, BytesToRead);
    inc(Result, BytesToRead);
  end;
end;
{--------}
function TaaReadBufferFilter.Seek(Offset : longint;
                                  Origin : word) : longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FStream.Position - FBufEnd + FBufPos
  else
    Result := inherited Seek(Offset, Origin);
end;
{====================================================================}


{===TaaWriteBufferFilter==============================================}
constructor TaaWriteBufferFilter.Create(aStream : TStream);
begin
  inherited Create(aStream);
  GetMem(FBuffer, BufferSize);
  FCurPos := FBuffer;
end;
{--------}
destructor TaaWriteBufferFilter.Destroy;
begin
  if (FBuffer <> nil) then begin
    if (FCurPos <> FBuffer) then
      wbfWriteBuffer;
    FreeMem(FBuffer, BufferSize);
  end;
  inherited Destroy;
end;
{--------}
function TaaWriteBufferFilter.wbfWriteBuffer : boolean;
var
  BytesToWrite : longint;
  BytesWritten : longint;
begin
  BytesToWrite := FCurPos - FBuffer;
  BytesWritten := FStream.Write(FBuffer^, BytesToWrite);
  if (BytesWritten = BytesToWrite) then begin
    Result := true;
    FCurPos := FBuffer;
  end
  else begin
    Result := false;
    if (BytesWritten <> 0) then begin
      Move(FBuffer[BytesWritten], FBuffer^, BytesToWrite - BytesWritten);
      FCurPos := FBuffer + (BytesToWrite - BytesWritten);
    end;
  end;
end;
{--------}
function TaaWriteBufferFilter.Seek(Offset : longint;
                                   Origin : word) : longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FStream.Position + (FCurPos - FBuffer)
  else
    Result := inherited Seek(Offset, Origin);
end;
{--------}
function TaaWriteBufferFilter.Write(const Buffer;
                                          Count : longint) : longint;
var
  UserBuf      : PChar;
  BytesToGo    : longint;
  BytesToWrite : longint;
begin
  {reference the buffer as a PChar}
  UserBuf := @Buffer;
  {start the counter for the number of bytes written}
  Result := 0;
  {if needed, empty the internal buffer into the underlying stream}
  if (BufferSize = FCurPos - FBuffer) then
    if not wbfWriteBuffer then
      Exit;
  {calculate the number of bytes to copy to the internal buffer}
  BytesToGo := Count;
  BytesToWrite := BufferSize - (FCurPos - FBuffer);
  if (BytesToWrite > BytesToGo) then
    BytesToWrite := BytesToGo;
  {copy the bytes from the user buffer to the internal buffer}
  Move(UserBuf^, FCurPos^, BytesToWrite);
  {adjust the counters}
  inc(FCurPos, BytesToWrite);
  dec(BytesToGo, BytesToWrite);
  inc(Result, BytesToWrite);
  {while there are more bytes to copy, do so}
  while (BytesToGo <> 0) do begin
    {advance the user buffer}
    inc(UserBuf, BytesToWrite);
    {empty the internal buffer into the underlying stream}
    if not wbfWriteBuffer then
      Exit;
    {calculate the number of bytes to copy to the internal buffer}
    BytesToWrite := BufferSize;
    if (BytesToWrite > BytesToGo) then
      BytesToWrite := BytesToGo;
    {copy the bytes from the user buffer to the internal buffer}
    Move(UserBuf^, FCurPos^, BytesToWrite);
    {adjust the counters}
    inc(FCurPos, BytesToWrite);
    dec(BytesToGo, BytesToWrite);
    inc(Result, BytesToWrite);
  end;
end;
{====================================================================}


{===TaaReadTextFilter================================================}
constructor TaaReadTextFilter.Create(aStream : TStream; aSize : longint);
begin
  inherited Create(aStream, aSize);
  FStrBuilder := TaaStringBuilder.Create;
end;
{--------}
destructor TaaReadTextFilter.Destroy;
begin
  FStrBuilder.Free;
  inherited Destroy;
end;
{--------}
function TaaReadTextFilter.AtEndOFStream : boolean;
begin
  Result := FSize = Position;
end;
{--------}
function TaaReadTextFilter.ReadLine : string;
const
  CR = ^M;
  LF = ^J;
var
  Ch : char;
  BytesRead : longint;
begin
  {read characters until we get an LF}
  BytesRead := Read(Ch, sizeof(Ch));
  while (BytesRead <> 0) and (Ch <> LF) do begin
    {if it's not a CR character, append it to the current line}
    if (Ch <> CR) then
      FStrBuilder.Add(Ch);
    BytesRead := Read(Ch, sizeof(Ch));
  end;
  {return the string}
  Result := FStrBuilder.AsString;
end;
{====================================================================}


{===TaaWriteTextFilter===============================================}
constructor TaaWriteTextFilter.Create(aStream : TStream);
begin
  inherited Create(aStream);
  {$IFDEF Win32}
  FLineDelim := ldCRLF;
  {$ENDIF}
  {$IFDEF Linux}
  FLineDelim := ldLF;
  {$ENDIF}
end;
{--------}
procedure TaaWriteTextFilter.WriteLine(const S : string);
const
  cLF : char = ^J;
  cCRLF : array [0..1] of char = ^M^J;
begin
  if (length(S) > 0) then
    Write(S[1], length(S));
  case FLineDelim of
    ldLF   : Write(cLF, sizeof(cLF));
    ldCRLF : Write(cCRLF, sizeof(cCRLF));
  end;
end;
{====================================================================}


{===TaaDebugFilter===================================================}
constructor TaaDebugFilter.Create(aStream  : TStream;
                            const aLogName : string);
begin
  Assert(aStream <> nil,
         'TaaDebugFilter.Create: the stream cannot be nil');
  inherited Create;
  FStream := aStream;
  FFile := TFileStream.Create(aLogName, fmCreate);
  FLog := TaaWriteTextFilter.Create(FFile);
end;
{--------}
destructor TaaDebugFilter.Destroy;
begin
  FLog.Free;
  FFile.Free;
  inherited Destroy;
end;
{--------}
function TaaDebugFilter.dfGetOriginStr(aOrigin : word) : string;
begin
  case aOrigin of
    soFromBeginning : Result := 'soFromBeginning';
    soFromCurrent   : Result := 'soFromCurrent';
    soFromEnd       : Result := 'soFromEnd';
  else
    Result := Format('Invalid origin [%d]', [aOrigin]);
  end;
end;
{--------}
function TaaDebugFilter.Read(var Buffer; Count : longint) : longint;
begin
  FLog.WriteLine(Format('READ:  Count requested: %d', [Count]));
  Result := FStream.Read(Buffer, Count);
  FLog.WriteLine(Format('       Bytes read: %d', [Result]));
end;
{--------}
function TaaDebugFilter.Seek(Offset : longint; Origin : word) : longint;
var
  OriginStr : string;
begin
  OriginStr := dfGetOriginStr(Origin);
  FLog.WriteLine(Format('SEEK:  Offset: %d, Origin: %s',
                        [Offset, OriginStr]));
  Result := FStream.Seek(Offset, Origin);
  FLog.WriteLine(Format('       Returned position: %d', [Result]));
end;
{--------}
function TaaDebugFilter.Write(const Buffer; Count : longint) : longint;
begin
  FLog.WriteLine(Format('WRITE: Count requested: %d', [Count]));
  Result := FStream.Write(Buffer, Count);
  FLog.WriteLine(Format('       Bytes written: %d', [Result]));
end;
{====================================================================}


{===TaaRegexTextFilter===============================================}
constructor TaaRegexTextFilter.Create(aStream : TStream;
                                      aSize : longint;
                                const aRegex : string);
begin
  inherited Create(aStream, aSize);
  FRegexEngine := TaaRegexCompiler.Create(aRegex);
end;
{--------}
destructor TaaRegexTextFilter.Destroy;
begin
  FRegexEngine.Free;
  inherited Destroy;
end;
{--------}
function TaaRegexTextFilter.ReadLine : string;
var
  S : string;
begin
  S := inherited ReadLine;
  while (FRegexEngine.MatchString(S) = 0) do begin
    if AtEndOFStream then begin
      Result := '';
      Exit;
    end;
    S := inherited ReadLine;
  end;
  Result := S;
end;
{====================================================================}


{===TaaWindowFilter==================================================}
constructor TaaWindowFilter.Create(aStream : TStream; aZeroPos : longint);
begin
  Assert(aStream <> nil,
         'TaaWindowFilter.Create: the stream cannot be nil');
  Assert(aZeroPos >= 0,
         'TaaWindowFilter.Create: the zero position cannot be negative');
  inherited Create;
  FStream := aStream;
  FZeroPos := aZeroPos;
  if (FStream.Position < aZeroPos) then
    FStream.Seek(aZeroPos, soFromBeginning);
end;
{--------}
destructor TaaWindowFilter.Destroy;
begin
  inherited Destroy;
end;
{--------}
function TaaWindowFilter.Read(var Buffer; Count : longint) : longint;
begin
  Result := FStream.Read(Buffer, Count);
end;
{--------}
function TaaWindowFilter.Seek(Offset : longint; Origin : word) : longint;
var
  NewPos : longint;
begin
  case Origin of
    soFromBeginning :
      NewPos := FStream.Seek(Offset + FZeroPos, soFromBeginning);
    soFromCurrent :
      NewPos := FStream.Seek(Offset, soFromCurrent);
    soFromEnd :
      NewPos := FStream.Seek(Offset, soFromEnd);
  else
    Assert(false, 'TaaWindowFilter.Seek: invalid Origin value');
    NewPos := 0;
  end;

  if (NewPos < FZeroPos) then
    NewPos := FStream.Seek(FZeroPos, soFromBeginning);

  Result := NewPos - FZeroPos;
end;
{--------}
function TaaWindowFilter.Write(const Buffer; Count : longint) : longint;
begin
  Result := FStream.Write(Buffer, Count);
end;
{====================================================================}

end.